home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0123_SNOW SCREEN SAVER.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  3KB  |  135 lines
  1.  
  2. {Hello All! I've recently coded this screen saver.It really looks like snow
  3. is falling all over, don't you think?
  4. However, I did not set out to do a snow screen saver and if you experiment
  5. with it a little you will see that it can even turn out to be a firework!
  6. If anyone can improve this code or make anything out of it, I would be
  7. very pleased to have a copy of the source.
  8. Please, excuse my English.I haven't practised it for a long time.}
  9.  
  10. PROGRAM SnowScreenSaver; {Nick Batalas 14-6-1994}
  11. USES crt,dos;
  12. const
  13.   dots =100;   {Set this to more than 100 and the result is awful}
  14.  
  15. var
  16.   j,k : integer; {loop variables}
  17.   i : longint;
  18.   x,y : array[1..dots] of integer;
  19.   cols    : array[1..dots] of byte;
  20.   f,g : word;
  21.  
  22. {--------------Procedures Needed For This Great Screen Saver------------}
  23. PROCEDURE SetVideoMode(mode : byte);assembler;
  24.   ASM
  25.     mov AH,0
  26.     mov AL,mode
  27.     int 10h
  28.   END;
  29.  
  30. PROCEDURE writeDACreg(color,red,green,blue : byte);
  31.   BEGIN
  32.      port[$03C8]:=color;
  33.      port[$03C9]:=red;
  34.      port[$03C9]:=green;
  35.      port[$03C9]:=blue;
  36.   END;
  37.  
  38. PROCEDURE SetBordColB(color : byte); Assembler;
  39.   ASM
  40.     mov AH,10h
  41.     mov AL,01h
  42.     mov BH,color
  43.     int 10h
  44.   END;
  45.  
  46. PROCEDURE PutPixel1(x, y : word; color : byte);
  47.   BEGIN
  48.     mem[$A000:x+y*320] := color;
  49.   END;
  50.  
  51. PROCEDURE HideTextCursor;
  52.   VAR
  53.     regs : registers;
  54.  
  55.   BEGIN
  56.     regs.ah:= 1;
  57.     regs.cx:=$2000;
  58.     intr($10,regs);
  59.   END;
  60.  
  61. Procedure WaitrBest;Assembler;
  62.   ASM
  63.     cli
  64.     mov dx,3DAh
  65.     @l1:
  66.     in al,dx
  67.     and al,08h
  68.     jnz @l1
  69.     @l2:
  70.     in al,dx
  71.     and al,08h
  72.     jz  @l2
  73.     sti
  74.   END;
  75.  
  76. FUNCTION xf3(ux,t : real) : word;   {Calculates the speed of a point}
  77.   BEGIN                             {on the x axis}
  78.     xf3 := round(ux*t)  +160;
  79.   END;
  80.  
  81. FUNCTION yf3(uy,g,t : real) : word; {Calculates the speed of a point}
  82.   VAR                               {on the y axis (which is affected}
  83.     u,tmax,hmax : real;             {by gravity)}
  84.     ym : array[1..200] of word;
  85.     a  : word;
  86.   BEGIN
  87.     u := uy-g*t;
  88.     a:= round(uy*t-1/2*g*t*t);
  89.     yf3 := 200-a ;
  90.   END;
  91.  
  92. Function RandomCol :byte;   {Just a random value between 7 and 15 (I think)}
  93.   BEGIN
  94.     randomcol:=random(6)+9;
  95.   END;
  96.  
  97. {-------------------------------MAIN PROGRAMME-------------------------}
  98. BEGIN
  99.   hideTextCursor;
  100.   j:=-50;                   {calculate the values of the speed of each dot}
  101.   for k:=1 to dots do begin {with this loop}
  102.     j:=j+3;
  103.     x[k]:=j;
  104.     y[k]:=random(150);
  105.   END;
  106.   For i:=1 to dots do      {Calculate the color of each dot}
  107.     cols[i]:= randomcol;
  108.   SetVideoMode($13);
  109.   For i:= 1 to 63 do
  110.     writedacreg(15,i,i,i);
  111.   writedacreg(7,15,15,15);       {modify color registers in order}
  112.   writedacreg(8,20,20,20);       {to give a sense of depth to the}
  113.   writedacreg(9,25,25,25);       {dots}
  114.   writedacreg(10,30,30,30);
  115.   writedacreg(11,35,35,35);
  116.   writedacreg(12,40,40,40);
  117.   writedacreg(13,45,45,45);
  118.   writedacreg(14,50,50,50);
  119.   For i:=1 to 5 do             {the background color turns to dark blue}
  120.     writedacreg(0,0,0,i);
  121.   setbordcolb(0);
  122.   i:=18500;
  123.   j:=1;
  124.   Repeat
  125.     i:=i+1;
  126.     FOR k:=1 to dots do
  127.       putpixel1(xf3(x[k],0.01*i),yf3(y[k],j,0.01*i),cols[k]);
  128.     waitrbest;
  129.     FOR k:=1 to dots do
  130.       putpixel1(xf3(x[k],0.01*i),yf3(y[k],j,0.01*i),0);
  131.   Until keypressed;
  132.   SetVideoMode(3);
  133.  
  134. END.
  135.